home *** CD-ROM | disk | FTP | other *** search
/ Wonky Flux Batch 2019 02 / Wonky_Flux_Batch_2019-02.zip / Wonky Flux Batch 2019-02 / 057 - Algebra Workshop.dsk / EQUATIONS.CLEAR.bas < prev    next >
BASIC Source File  |  2019-02-17  |  9KB  |  268 lines
  1. 100  REM    EQUATIONS CLEAR
  2. 110  GOTO 2320
  3. 120  HOME 
  4. 130  REM  GCD SUBROUTINE:A,B IN,GCD OUT
  5. 140  REM  SUBROUTINE ASSUMES B<>0
  6. 150 Q =  INT(A/B): REM  DIVIDE A BY B
  7. 160 R = A -Q *B: REM  REMAINDER
  8. 170  IF R = 0  THEN 210: REM   ALGORITHM FINISHED,GCD IS B
  9. 180  REM  IF R <> 0 MUST DO ANOTHER DIVISION
  10. 190  REM  NOW SET UP FOR NEXT DIVISION
  11. 200 A = B:B = R: GOTO 150
  12. 210 GCD = B
  13. 220  RETURN 
  14. 230  REM  SUBROUTINE FINISHED
  15. 240  REM 
  16. 250  REM   SUBROUTINE TO REDUCE FRACTION
  17. 260  REM  USING GCD SUBROUTINE
  18. 270  REM    NUM, DEN IN, NNUM,NDEN OUT
  19. 280  REM  IF NUM = 0, SKIP GCD SUBRTN
  20. 290  IF NUM = 0  THEN NNUM = 0:NDEN = 1: RETURN 
  21. 300 A = NUM:B = DEN
  22. 310  GOSUB 150: REM  GCD SUBROUTINE
  23. 320  REM  SUBROUTINE RETURNS GCD
  24. 330  REM   NOW DIVIDE OUT BY GCD:
  25. 340 NNUM = NUM/GCD:NDEN = DEN/GCD
  26. 350  REM  REDUCED FORM IS NNUM/NDEN
  27. 360  RETURN 
  28. 370  REM 
  29. 380  REM  SUBROUTINE TO MULTIPLY FRACS
  30. 390  REM  N1/D1 AND N2/D2 IN, N3/D3 OUT
  31. 400  REM 
  32. 410  REM  COMPUTE UNREDUCED PRODUCT NUM/DEN
  33. 420 NUM = N1 *N2
  34. 430 DEN = D1 *D2
  35. 440  GOSUB 250: REM   REDUCE TO NNUM/NDEN
  36. 450  REM  SET UP FOR RETURN
  37. 460 N3 = NNUM:D3 = NDEN
  38. 470  RETURN 
  39. 480  REM 
  40. 490  REM 
  41. 500  REM  SUBROUTINE TO ADD FRACTIONS
  42. 510  REM  N1/D1 AND N2/D2 IN,
  43. 520  REM  SUM N3/D3 OUT
  44. 530  REM  FORM UNREDUCED SUM:
  45. 540 NUM = N1 *D2 +N2 *D1
  46. 550 DEN = D1 *D2
  47. 560  IF NUM = 0  THEN N3 = 0:D3 = 1: GOTO 590: REM  SKIP REDUCE
  48. 570  GOSUB 250: REM  REDUCE TO NNUM/NDEN
  49. 580 N3 = NNUM:D3 = NDEN
  50. 590  RETURN 
  51. 600  REM 
  52. 610  REM  SUBRTN TO READ FRAC FROM KYBD
  53. 620  REM  SUBRTN EXPECTS STRING NUM/DEN
  54. 630  REM         AND EXTRACTS NUM AND DEN
  55. 640  REM  BEFORE ENTERING SBRTN, SET
  56. 650  REM   VV$= SOME CONNECTING WORD
  57. 660  REM :PRINT : PRINT "PLEASE TYPE ";VV$;"FRACTION"
  58. 670  INPUT A$
  59. 680  REM  SEARCH FOR "/" IN A$:
  60. 690  FOR K = 1 TO  LEN(A$)
  61. 700  REM   LOOK AT K TH CHARACTER OF A$:
  62. 710 CHAR$ =  MID$ (A$,K,1)
  63. 720  IF CHAR$ = "/"  THEN 790: REM   FOUND "/"
  64. 730  NEXT : REM  KEEP LOOKING FOR "/"
  65. 740  REM  HERE, A$ HAS NO "/";ASSUME A$ IS INTEGER
  66. 750 NUM =  VAL(A$): REM  NUMERICAL VAL OF A$
  67. 760 DEN = 1
  68. 770  RETURN 
  69. 780  REM  HERE, HAVE FOUND "/" AS K-TH CHAR OF A$
  70. 790 NUM$ =  LEFT$(A$,K -1)
  71. 800 DEN$ =  RIGHT$(A$, LEN(A$) -K)
  72. 810 NUM =  VAL(NUM$)
  73. 820 DEN =  VAL(DEN$)
  74. 830  IF DEN = 0  THEN  PRINT : PRINT "DENOMINATOR NOT ALLOWED TO BE ZERO.": GOTO 660
  75. 840  RETURN 
  76. 850  REM 
  77. 860  REM   SUB TO GET EQUATIONS
  78. 870  REM   
  79. 880  HOME 
  80. 890  PRINT "HOW MANY VARIABLES";: INPUT VARS
  81. 900  PRINT : PRINT "HOW MANY EQUATIONS";: INPUT EQNS
  82. 910  DIM N(EQNS,VARS +1),D(EQNS,VARS +1)
  83. 920  FOR ROW = 1 TO EQNS
  84. 930  HOME 
  85. 940  REM  GET EQUATION "ROW":
  86. 950  REM 
  87. 960  PRINT "TYPE IN  A(1)...A(";VARS;"),";
  88. 970  PRINT "AND B ": PRINT : PRINT "FOR EQUATION ";ROW
  89. 980  PRINT : FOR COL = 1 TO VARS
  90. 990  IF COL <VARS  THEN  PRINT "A(";COL;")X";COL;"+";
  91. 1000  IF COL = VARS  THEN  PRINT "A(";COL;")X";COL;"=";
  92. 1010  NEXT 
  93. 1020  PRINT "B";: PRINT 
  94. 1030  FOR COL = 1 TO VARS
  95. 1040  PRINT : PRINT "A(";COL;")=";: GOSUB 610: REM   FRAC GETTER
  96. 1050 N(ROW,COL) = NUM:D(ROW,COL) = DEN
  97. 1060  NEXT 
  98. 1070  PRINT : PRINT "B";"=";: GOSUB 610: REM   FRAC GETTER
  99. 1080 N(ROW,VARS +1) = NUM:D(ROW,VARS +1) = DEN
  100. 1090  PRINT : PRINT "CHECK THE EQUATION": PRINT 
  101. 1100  GOSUB 1310
  102. 1110  PRINT : PRINT "IS THIS CORRECT (Y OR N)";
  103. 1120  REM 
  104. 1130  INPUT ANS$: IF ANS$ = "N"  THEN  HOME : GOTO 960
  105. 1140  IF ANS$ < >"Y"  THEN 1130
  106. 1150  NEXT ROW
  107. 1160  RETURN 
  108. 1170  REM 
  109. 1180  REM 
  110. 1310  REM 
  111. 1320  REM   SUB TO PRINT EQUATION J
  112. 1330  REM 
  113. 1340 FLAG = 0: REM  SET = 1 WHEN FIRST NON-ZERO COEF IS FOUND
  114. 1350  PRINT ROW;")  ";
  115. 1360  FOR COL = 1 TO VARS
  116. 1370  REM  IF COEF = 0, DON'T PRINT
  117. 1380  IF N(ROW,COL) = 0  THEN  PRINT  SPC( 4): GOTO 1540: REM   NEXT COL
  118. 1390  REM  HERE, HAVE NON-ZERO COEF
  119. 1400  REM  IF FLAG = 1, IT'S NOT THE FIRST NON-ZERO COEF
  120. 1410  REM  PRINT "+" ONLY FOR POS COEFS
  121. 1420  REM            AFTER THE FIRST
  122. 1430  IF FLAG = 1  AND N(ROW,COL) >0  THEN  PRINT "+";
  123. 1440 FLAG = 1
  124. 1450  REM  DON'T PRINT "1" DENOMS
  125. 1460  REM  DON'T PRINT "1/1" COEFS
  126. 1470  IF D(ROW,COL) = 1  THEN  IF N(ROW,COL) < >1  THEN  PRINT N(ROW,COL);
  127. 1480  REM  PUT "()" AROUND POS FRACS
  128. 1490  IF D(ROW,COL) < >1  AND N(ROW,COL) >0  THEN  PRINT "(";N(ROW,COL);"/";D(ROW,COL);")";
  129. 1500  REM  DON'T PUT "()" AROUND NEG FRACS
  130. 1510  IF D(ROW,COL) < >1  AND N(ROW,COL) <0  THEN  PRINT N(ROW,COL);"/";D(ROW,COL);
  131. 1520  REM  PRINT VARIABLE NAME:
  132. 1530  PRINT "X";COL;
  133. 1540  NEXT 
  134. 1550  REM  HERE, HAVE DEALT WITH ALL X'S
  135. 1560  REM  IF FLAG = 0, ALL COEFS WERE 0
  136. 1570  IF FLAG = 0  AND N(ROW,VARS +1) = 0  THEN 1650: REM   WHOLE EQN IS ZERO
  137. 1580  IF FLAG = 0  AND N(ROW,VARS +1) < >0  THEN  PRINT "ZERO";: REM    X TERMS 0, CONST NON-ZERO
  138. 1590  REM  HERE, FLAG<>0, SO HAVE NON-ZERO X TERM
  139. 1600  PRINT "=";
  140. 1610  PRINT N(ROW,VARS +1);
  141. 1620  REM   DON'T PRINT "1" DENOMS:
  142. 1630  IF D(ROW,VARS +1) < >1  THEN  PRINT "/";D(ROW,VARS +1);
  143. 1640  REM  CLEAR TO END OF LINE:
  144. 1650  PRINT  SPC( 40 - POS(0))
  145. 1660 FLAG = 0
  146. 1670  RETURN 
  147. 1680  REM 
  148. 1690  REM  
  149. 1700  REM  SUB TO MULT EQN BY CONST
  150. 1710  REM 
  151. 1720  HOME 
  152. 1730  PRINT "MULTIPLY WHICH EQUATION";: INPUT ROW
  153. 1740  PRINT 
  154. 1750  PRINT "MULTIPLY BY WHAT?": GOSUB 610: REM  FRAC GETTER 
  155. 1760  REM  SET UP FOR MULT SUBRTN
  156. 1770 N1 = NUM:D1 = DEN
  157. 1780  FOR COL = 1 TO VARS +1
  158. 1790 N2 = N(ROW,COL):D2 = D(ROW,COL)
  159. 1800  GOSUB 380: REM  MULT SUBRTN
  160. 1810 N(ROW,COL) = N3:D(ROW,COL) = D3
  161. 1820  NEXT COL
  162. 1830  REM  PRINT EQUATIONS
  163. 1840  GOSUB 2060
  164. 1850  RETURN 
  165. 1860  REM 
  166. 1870  REM 
  167. 1880  REM 
  168. 1890  REM  SUB TO ADD EQUATIONS
  169. 1900  REM   ADD EQN FST TO EQN SND 
  170. 1910  REM  PUT RESULT IN EQN SND
  171. 1920  REM 
  172. 1930  PRINT "ADD EQUATION I TO EQUATION J": PRINT 
  173. 1940  PRINT " I = ": INPUT FST: PRINT 
  174. 1950  PRINT " J = ": INPUT SND: PRINT 
  175. 1960  FOR COL = 1 TO VARS +1
  176. 1970  REM  SET UP FOR ADD SUBRTN
  177. 1980 N1 = N(FST,COL):D1 = D(FST,COL)
  178. 1990 N2 = N(SND,COL):D2 = D(SND,COL)
  179. 2000  GOSUB 500: REM  ADD SUBRTN
  180. 2010 N(SND,COL) = N3:D(SND,COL) = D3
  181. 2020  NEXT 
  182. 2030  REM   PRINT EQUATIONS:
  183. 2040  GOSUB 2060
  184. 2050  RETURN 
  185. 2060  REM  SUBRTN TO PRINT ALL EQNS
  186. 2070  POKE 34,0
  187. 2080  HOME 
  188. 2090  FOR ROW = 1 TO EQNS
  189. 2100  GOSUB 1310: REM  SINGLE EQN PRINTER
  190. 2110  NEXT 
  191. 2120  POKE 34,6 +EQNS
  192. 2130  RETURN 
  193. 2140  REM 
  194. 2150  REM  SUBRTN TO INTERCHANGE EQNS
  195. 2160  REM     SWITCH EQNS "FST" AND "SND"
  196. 2170  HOME 
  197. 2180  PRINT : PRINT "INTERCHANGE WHICH EQUATIONS"
  198. 2190  PRINT : PRINT "FIRST=";: INPUT FST
  199. 2200  PRINT "SECOND=";: INPUT SND
  200. 2210  FOR COL = 1 TO VARS +1
  201. 2220  REM   HOLD COEF OF X(COL) FROM EQN FST:
  202. 2230 NT = N(FST,COL):DT = D(FST,COL)
  203. 2240  REM  NOW SWITCH:
  204. 2250 N(FST,COL) = N(SND,COL)
  205. 2260 D(FST,COL) = D(SND,COL)
  206. 2270 N(SND,COL) = NT
  207. 2280 D(SND,COL) = DT
  208. 2290  NEXT : GOSUB 2060: REM   PRINT EQUATIONS
  209. 2300  RETURN 
  210. 2310  REM 
  211. 2320  REM  PROG TO REDUCE EQUATIONS
  212. 2330  HOME 
  213. 2340  PRINT "     THIS PROGRAM WORKS WITH SYSTEMS OF"
  214. 2350  PRINT : PRINT "LINEAR EQUATIONS IN ONE OR MORE"
  215. 2360  PRINT : PRINT "VARIABLES."
  216. 2370  PRINT : PRINT : PRINT "     IT CAN INTERCHANGE EQUATIONS AND"
  217. 2380  PRINT : PRINT "CLEAR VARIABLES, GIVEN THE PIVOT"
  218. 2390  PRINT : PRINT "EQUATION AND VARIABLE."
  219. 2400  VTAB 20
  220. 2410  PRINT "PRESS ANY KEY TO CONTINUE."
  221. 2420  GET ANS$
  222. 2430  HOME 
  223. 2440  GOSUB 850: REM   GET EQUATIONS
  224. 2450  HOME 
  225. 2460  GOSUB 2060: REM   PRINT EQUATIONS
  226. 2470  PRINT : PRINT "TO INTERCHANGE, TYPE I"
  227. 2480  PRINT : PRINT "TO CLEAR A VARIABLE, TYPE C"
  228. 2490  PRINT : PRINT "TO STOP, TYPE S"
  229. 2500  PRINT : PRINT "WHICH DO YOU WISH TO DO";
  230. 2510  INPUT ANS$
  231. 2520  IF ANS$ = "I"  THEN  GOSUB 2150: GOTO 2470
  232. 2530  IF ANS$ = "C"  THEN  GOSUB 2570: GOTO 2470
  233. 2540  IF ANS$ = "S"  THEN  POKE 34,0: HOME : PRINT "SO LONG!": FOR I = 1 TO 1000: NEXT I: PRINT  CHR$(4);"RUN MENU"
  234. 2550  GOTO 2500
  235. 2560  REM 
  236. 2570  REM   SUBROUTINE TO CLEAR A VARIABLE
  237. 2580  HOME 
  238. 2590  PRINT : PRINT "CLEAR WHICH VARIABLE";
  239. 2600  INPUT PVAR$:PVAR =  VAL( RIGHT$(PVAR$,1))
  240. 2610  PRINT "USING WHICH EQUATION";
  241. 2620  INPUT PEQN
  242. 2630  REM   REDUCE PIVOT COEFFICIENT TO 1
  243. 2640  REM  SET UP FOR MULT SBRTN
  244. 2650 ROW = PEQN
  245. 2660 N1 = D(PEQN,PVAR):D1 = N(PEQN,PVAR): REM   NOTE RECIPROCAL
  246. 2670  GOSUB 1780: REM   MULT EQN "ROW" BY N1/D1
  247. 2680  FOR RW = 1 TO EQNS
  248. 2690  REM  SKIP PIVOT EQN AND THOSE WITH COEF ON X(PVAR) ALREADY 0:
  249. 2700  IF RW = PEQN  OR N(RW,PVAR) = 0  THEN 2880
  250. 2710  REM  MULT PEQN SO AS TO CANCEL
  251. 2720  REM  MULT PIVOT EQN BY ADDITIVE INVERSE
  252. 2730  REM   OF COEF OF X(PVAR) IN EQN RW:
  253. 2740  REM   SET UP FOR MULTIPLYING SUBROUTINE:
  254. 2750 ROW = PEQN
  255. 2760 N1 =  -N(RW,PVAR):D1 = D(RW,PVAR): REM  NOTE ADDITIVE INVERSE
  256. 2770  GOSUB 1780: REM    MULT EQN "ROW" BY N1/D1
  257. 2780  REM   ADD NEW EQUATION PEQN TO EQN RW     
  258. 2790  REM   TO CANCEL X(PVAR) TERM FROM EQN RW:  
  259. 2800 FST = PEQN:SND = RW: GOSUB 1960
  260. 2810  PRINT 
  261. 2820  REM   RESTORE PIVOT EQUATION
  262. 2830  IF N(PEQN,PVAR) = 1  AND D(PEQN,PVAR) = 1  THEN 2880: REM  SKIP RESTORING
  263. 2840  REM  SET UP FOR MULT SUBRTN:
  264. 2850 ROW = PEQN
  265. 2860 N1 = D(PEQN,PVAR):D1 = N(PEQN,PVAR): REM  NOTE RECIPROCAL 
  266. 2870  GOSUB 1780: REM  MULT SUBRTN
  267. 2880  NEXT : REM   CLEAR X(PVAR) FROM NEXT EQN
  268. 2890  RETURN